home *** CD-ROM | disk | FTP | other *** search
/ Apple Developer Connection Student Program / ADC Tools Sampler CD Disk 3 1999.iso / Cool Demos, SDKs, & Tools / Demos⁄Tools⁄Offers / Alpha ƒ / Tcl / Packages / recentFiles.tcl < prev    next >
Text File  |  1999-05-18  |  6KB  |  174 lines
  1. ## -*-Tcl-*- (install)
  2.  # ###################################################################
  3.  #  Alpha - new Tcl folder configuration
  4.  # 
  5.  #  FILE: "recentFiles.tcl"
  6.  #                                    created: 21/9/97 {9:14:38 pm} 
  7.  #                                last update: 05/18/1999 {15:01:33 PM} 
  8.  #  
  9.  # Reorganisation carried out by Vince Darley with much help from Tom 
  10.  # Fetherston, Johan Linde and suggestions from the Alpha-D mailing list.  
  11.  # Alpha is shareware; please register with the author using the register 
  12.  # button in the about box.
  13.  #  
  14.  # original author probably Pete Keleher.  Vince added a bunch of
  15.  # code to work-around some Alpha-menu problems, and made it a 
  16.  # package.
  17.  # 
  18.  # Version 0.2 builds the menu about a zillion times faster than
  19.  # the original which built the menu once for every item at
  20.  # startup!  Also removed two unnecessary procs, since that stuff
  21.  # can be done elsewhere automatically.
  22.  # ###################################################################
  23.  ##
  24.  
  25. alpha::extension recentFilesMenu 0.3.0 {
  26.     namespace eval recent {}
  27.     ensureset recent::Files ""
  28.     hook::register saveasHook recent::push
  29.     hook::register openHook recent::push
  30.     menu::buildProc recent recent::makeMenu
  31.     menu::insert File submenu 2 recent
  32.     lappend modifiedVars recent::Files
  33.     # declare the fileset
  34.     set "gfileSetsType(Recent Files)" "procedural"
  35.     set "gfileSets(Recent Files)" recent::listFiles
  36.     lunion filesetsNotInMenu "Recent Files"
  37. } help {Adds a menu of recent files to the files menu, and a recent files fileset}
  38.  
  39. lunion varPrefs(Files) numberOfRecentFiles orderRecentFilesBy editLastUsedFile
  40. # The number of files to list in the 'Files->Recent' menu.
  41. newPref variable numberOfRecentFiles 15
  42. # The ordering scheme for items in the recent files menu.
  43. newPref variable orderRecentFilesBy 0 global recent::makeMenu [list \
  44.   "Alphabetical Order" "Date"] index
  45. # Use this key binding to edit the most recently used file.
  46. newPref binding editLastUsedFile "" global "" recent::editLastFile
  47.  
  48.  
  49. ## 
  50.  # -------------------------------------------------------------------------
  51.  # 
  52.  # "recent::push" --
  53.  # 
  54.  #  Works with files whose name contained '[' or ']' which didn't before.
  55.  #  Doesn't add any file which fails 'file exists' to the menu.
  56.  # -------------------------------------------------------------------------
  57.  ##
  58. proc recent::push {name {name2 ""}} {
  59.     if {$name2 != ""} { set name $name2 }
  60.     global recent::Files numberOfRecentFiles file::separator orderRecentFilesBy
  61.     
  62.     regsub { <[0-9]+>$} $name {} name
  63.     if {![file exists $name]} { return }
  64.     if {[info tclversion] < 8.0} {
  65.     regsub -all {\\([][])} $name {\1} name
  66.     # this weird search handles a variety of unusual problems with
  67.     # Alpha's interpretation of menu items.
  68.     if {[info exists recent::Files] \
  69.       && ([set ind [lsearch -regexp ${recent::Files} "${file::separator}[quote::Regfind [file tail $name]]…?$"]] >= 0)} {
  70.         set recent::Files [lreplace ${recent::Files} $ind $ind]
  71.         lappend recent::Files $name
  72.         if {$orderRecentFilesBy} {recent::makeMenu}
  73.         return
  74.     }
  75.     } else {
  76.     if {[info exists recent::Files] \
  77.       && ([set ind [lsearch -exact ${recent::Files} $name]] >= 0)} {
  78.         set recent::Files [lreplace ${recent::Files} $ind $ind]
  79.         lappend recent::Files $name
  80.         if {$orderRecentFilesBy} {recent::makeMenu}
  81.         return
  82.     }
  83.     set ind 0
  84.     foreach f $recent::Files {
  85.         # perhaps we ought to test also for complications due to 
  86.         # files which end in '…'.
  87.         if {[file tail $f] == [file tail $name]} {
  88.         set recent::Files [lreplace ${recent::Files} $ind $ind]
  89.         lappend recent::Files $name
  90.         if {$orderRecentFilesBy} {recent::makeMenu}
  91.         return
  92.         }
  93.         incr ind
  94.     }
  95.     }
  96.  
  97.     lappend recent::Files $name
  98.     if {[llength ${recent::Files}] > $numberOfRecentFiles} {
  99.     set recent::Files [lrange ${recent::Files} 1 end]
  100.     }
  101.     recent::makeMenu
  102. }
  103.  
  104. proc recent::makeMenu {args} {
  105.     global recent::Files orderRecentFilesBy
  106.     set tails {}
  107.     foreach t ${recent::Files} {
  108.     lappend tails [file tail $t]
  109.     }
  110.     if {$orderRecentFilesBy} {
  111.     Menu -m -c -n recent -p recent::menuProc \
  112.       [concat [lreverse $tails] [list "(-" "Reset List"]]
  113.     } else {
  114.     Menu -m -c -n recent -p recent::menuProc \
  115.       [concat [lsort -ignore $tails] [list "(-" "Reset List"]]
  116.     }
  117.     set enable [expr [llength ${recent::Files}] ? 1 : 0]
  118.     enableMenuItem File recent $enable
  119. }
  120.  
  121. ## 
  122.  # -------------------------------------------------------------------------
  123.  # 
  124.  # "recent::menuProc" --
  125.  # 
  126.  #  Works with menu items which contain '[', ']' and '…' which didn't work
  127.  #  before.
  128.  # -------------------------------------------------------------------------
  129.  ##
  130. proc recent::menuProc {menu name} {
  131.     global recent::Files file::separator
  132.     
  133.     if {$name == "Reset List"} {
  134.     set recent::Files {}
  135.     Menu -m -n recent -p recent::menuProc {}
  136.     recent::makeMenu
  137.     } else {
  138.     if {[set ind [lsearch -regexp ${recent::Files} "${file::separator}[quote::Regfind $name]…?$"]] >= 0} {
  139.         edit [lindex ${recent::Files} $ind]
  140.     } else {
  141.         # Sometime the above regexp search can have difficulties
  142.         # due to weird chars, or file-separator confusion.
  143.         foreach f ${recent::Files} {
  144.         if {[file tail $f] == $name} {
  145.             edit $f
  146.             return
  147.         }
  148.         }
  149.         dialog::errorAlert "Couldn't find a file '$name'.  Weird!"
  150.     }
  151.     }
  152. }
  153.  
  154. ## 
  155.  # -------------------------------------------------------------------------
  156.  # 
  157.  # "recent::listFiles" --
  158.  # 
  159.  #  Used to retrieve the list of files in the 'recent files' fileset
  160.  # -------------------------------------------------------------------------
  161.  ##
  162. proc recent::listFiles {} {
  163.     global recent::Files
  164.     return ${recent::Files}
  165. }
  166.  
  167. proc recent::editLastFile {} {
  168.     global recent::Files
  169.     if {[set rl [llength ${recent::Files}]]} {
  170.     incr rl -1
  171.     edit -c -w [lindex ${recent::Files} $rl]
  172.     }
  173. }
  174.